C  SUBRS.  SLUR, (JUGGLE), (LOOP), (PLTSRT), (LINES), (HOMER),
C  (PLACE), (FINDIT), SCL,(FORMAT), IBLANK, BMX, ACSHFT, SETUP

	SUBROUTINE SLUR
	IMPLICIT INTEGER(A-Q,T-Z)
	COMMON/SLR/ SLURX(32)
	REAL CENTR
	COMMON /XRN/RN(1) /PLTR/PLT,RHT,RDIS 
	COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RB,
	1 K,KQ,TWICE,RST7,RX,RXX,RTILT,RC,RZ,RW,J3,J4,
	1 J5,J6,J7,J8,J9,J10,J11,JQ(8),RJ
	COMMON/PTR/PWDS(1) /STF/RSTFAC(0/7),RSTJ2 
	1 /LIMIT/LIMIT,ITEM,L,I,IX /ALF/INP,SLURY(72) 
CC	DATA RSLUR/22.0/
CF	DATA RZZ/2.8/
C  DEFAULT VALUE OF SLUR CURVE FACTOR IS 2.8	

CCC	IF(JA.NE.12)GO TO 2
CF	RA=5.96*RSTJ2*R5
CF	L=3
CF	J8=J8*RDIS
CF	IF(J7.LE.J6)J7=J7+360
CF	KQ=6
CF	IF(PLT)KQ=1
CF10	DO 3 K=J6,J7,KQ
CF	R=K
CF	CALL LINES(R3+RA*SIND(R),CENTR+RA*COSD(R),L)
CF3	L=2
CF	J8=J8-1
CF	IF(J8)RETURN
CF	RA=RA+1/RDIS
CF	L=3
CF	GO TO 10
CJA=12  DRAWS CIRCLES. P5=RADIUS, P6=DEGR.1, P7=DEGR.2,P8=THICK(EXPANDS
CCC	CALL CIRCLE
CCC	RETURN

C*** SLURS *** 5, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY
C  P9=NUM IN BRACKET(IF NON-ZERO)
2	J10=1
	J4=-1
	J5=1
C  ↑↑↑↑ FOR DPY ONLY (32 SEGS ARE USED)
	TWICE=-1
	IF(R3.GT.-1000)GO TO 2100
	R=-R3-1000
	L=R
	R=-(R3+1000+R)
	R3=RN(PWDS(L)+4)+R
2100	IF(R6.GT.-1000)GO TO 21  
	R=-R6-1000
	L=R
	R=-(R6+1000+R)
	R6=RN(PWDS(L)+4)+R
COCT	IF(R6)R6=202
C  R6=NEG. IS FOR PAGE-LAYOUT PROG. TELLS WHICH NOTE TO SLUR TO.
21	RST7=RSTJ2*7.
	RJ=ABS(R7)
C R7+100=LEFT HALF SLUR, +200=RIGHT HALF, +300=REVERSE DIRECTION.
	IF(RJ.LT.100)RJ=-1
	R7=AMOD(R7,100.0)
	IF(RJ.LT.300)GO TO 20
	RJ=0
CC*** NOT YET!	R5=R5-(2*R7)
C R5 THINKS THE SLUR ISN'T REVERSED.
C TO USE THIS ADD R6=SQRT((R5-R4)**2+(R6-R3)**2)+R3(WITH FACTORS)
20	RQQ=R5-R4
	IF(R6.GT.1000)CALL RNOTE(R6)
	GO TO (5,6,7),J8+4
	GO TO 4
CC5	R=32
5	R=30
C AFTER DOTTED NOTE
	GO TO 8
6	R=22
CC6	R=RSLUR
C BETWEEN NOTES
CC8	RX=-1.3
8	RX=-0.75
	GO TO 9
7	R=7
	RX=RSTJ2
9	CALL RJBX(R)
	R6=R6+RX
4	RXX=RHORZ(R6)-R3
	RTILT=RQQ*RST7
80	RX=SQRT(RXX**2+RTILT**2)
	IF(J8.NE.-1)GO TO 1
	IF(RQQ.GT.8)RQQ=8
	IF(RQQ.LT.-8)RQQ=-8
	RQQ=RQQ*RSTFAC(J2)*1.0
	IF(R7)RQQ=-RQQ
	R3=R3-RQQ
C  MOVES STEEP SLUR LEFT OR RIGHT IF P8=-1
1	R=CENTR
	IF(J8.GT.0)GO TO 180
C  JUMP FOR BRACKETS
	L=32
	CALL SLOOP

CF	RB=RX/71.
CF	DO 81 K=0,71
CF81	SLURX(K+1)=RB*(K)+R3
CF	RA=R7*RST7
CF41	IF(R9.EQ.0)R9=RZZ
CF	R=R+RA
CF	L=0
CF	DO 40 K=36,1,-1
CF	L=L+1
CF	RW=R-RA*(K/36.)**R9
CF	SLURY(L)=RW
CF40	SLURY(73-L)=RW
CF	L=72

CF89	IF(RTILT.EQ.0)GO TO 87
CF	RW=ATAN2(RTILT,RXX)
CF	RA=SIN(RW)
CF	RB=COS(RW)
CF	RZ=SLURX(1)
CF	RW=SLURY(1)
CF	DO 83 K=1,L
CF	R=SLURX(K)-RZ
CF	RXX=SLURY(K)-RW
CF	SLURX(K)=RB*R-RA*RXX+RZ
CF83	SLURY(K)=RB*RXX+RA*R+RW

87	IF(J4)CALL LINES(SLURX(J10),SLURY(J10),3)
	J6=J10
	J7=L
	IF(J4.NE.0)GO TO 22
	CALL EXCH(J6,J7)
	J5=-1
22	DO 88 K=J6,J7,J5
88	CALL LINES(SLURX(K),SLURY(K),2)
	IF(J5.GT.1)CALL LINES(SLURX(L),SLURY(L),2)
C  DISPLAY END POINT OF SLUR
	IF(TWICE)RETURN
	TWICE=TWICE-1
	GO TO 182
180	RW=R+R7*RST7
	TWICE=-1
CC	KQ=1
	J5=1
	RX=RX+R3
CC	RA=(R5-R4)*RST7
	IF(J9.EQ.0)GO TO 181
	RZ=RTILT/(RX-R3)
	TWICE=2
CC	RZ=RX-R3
	RXX=RX
	RWID=(R3+RXX)/2.
182	IF(TWICE.EQ.1)GO TO 183
C  DOES LEFT SIDE FIRST.
	IF(TWICE.EQ.0)GO TO 184
C LAST IS NUMBER.
	J8=2
	RC=RSTJ2*13.
	RX=RWID-RC
	RWW=RTILT
185	RTILT=RZ*(RX-R3)

C  PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.

	GO TO 181
183	J8=3
	RX=RXX
	RTILT=RWW
	RXX=R3
	R3=RWID+RC
	RXX=RZ*(R3-RXX)
	R=R+RXX
	RW=RW+RXX
	GO TO 185

181	SLURX(1)=R3
	SLURY(1)=R
	SLURX(2)=R3
	SLURY(2)=RW
	SLURX(3)=RX
	SLURY(3)=RW+RTILT
	SLURX(4)=RX
	SLURY(4)=R+RTILT
	L=4
	IF(J8.EQ.2)L=3
	IF(J8.EQ.3)J10=2
CC	TWICE=-1
	GO TO 87
184	J3=RWID
C  PUT IN VERT. POS. WHEN SLOPE!
	R4=RQQ/2.+R4+R7-1.
	R6=0.875
C  SIZE(R6) IS 0.875   R7=1 IS FOR ITALICS
	R7=1
	R8=0
	CALL MAKNUM(R9)
	END

	SUBROUTINE SCL
C  SETS UP SCALING MARKERS.
	COMMON /STF/RSTFAC(0/7),RSTJ2 /RINP/SU(900)
	COMMON R2,JA,CT,J2,R3,R4,R5,RJQ(17),J3,J4,J5,J6,J(16)
	1 /POSI/STFF(0/7),J102,POS
	J2=R2
	IF(J2.NE.99)GO TO 1008
	CALL HYDPOG(2)
	RETURN
1008	J5=0
	J6=0
	RSTJ2=RSTFAC(J2)
C  SETS UP SCALE LINES.
	J4=200
	IF(R3.NE.0)J4=400
C  PUTS SCALE TO 400
	R2=STFF(J2)+60.*RSTJ2
	RJ=R2+60.
	CALL DPYSET(2,SU,700)
	CALL DPYBRT(1)
	POS=RJ+40.
	RSTJ2=1.
	DO 1002 MX=10,J4,10
	RA=RHORZ(FLOAT(MX))
	R3=RA-58
	IF(MX.GT.10)CALL PNUM
CC1005	IF(R5.NE.0)GO TO 1007
C  JUMP FOR STAFF NUMBERS
	CALL LINX(RA,R2,RA,RJ)
	J5=J5+1
1002	IF(J5.EQ.10)J5=0
	CALL LINES(-596.0,RJ,2)
	CALL LINES(-596.0,R2,2)
	R6=1.5
C  NEXT SETS UP STAFF NUMBERS
	R3=-620.
	DO 1007 K=0,7 
	POS=STFF(K)+40.
	J5=IABS(K)
	CALL PNUM
1007	CONTINUE
	CALL DPYOUT(2)
	CALL SETPOG(1)
	END

	FUNCTION IBLANK(IS,N)
	COMMON /XRN/RN(2000)
	IBLANK=0
	IF(AMOD(RN(IS+N),100.0).EQ.99.0)IBLANK=-1
	END

	SUBROUTINE BMX(RA)
C  RA=NUMB. OF TAILS
C  VQ HOLDS TEMPORARY INFO RE. MULTIPLE BEAMS.
	COMMON E,F,G,H,RJQ(34),RB,VQX,JB,B,JV,JW /XRN/RN(1)
	1 /RINP/R(10,85),VQ(100) /STF/RSTFAC(0/7),RSTJ2
	1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
	1/LIMIT/LIMIT,ITEM,LL,IS,IX /SC/J,L,MK
	1 ,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,IXX,ISEMI,IQT
	1 ,VX(50),IAMP,K,KN,M,MODE,IBLA
	1 /SCX/JALPHA(30),JX,U,JZ,IRHY,JD,KA,KB,IZ
	M=IS-12
	DO 1 L=KN,K
	B=AMOD(R(7,L),10.0)
	IF(R(8,L).EQ.1000.)B=0
C AVOIDS GRACE NOTES
1	VQ(L)=B
	VQ(K+1)=0
C   CLEARS IT FOR ROUTINE AT '3'
	JB=KN

6	DIS=0
	RB9=0
	DO 2 L=JB,K
	IF(VQ(L).LE.RA)GO TO 2
C  SKIP IF EQ. TO PRESENT BEAM
	RB=VQ(L)
4	DO 11 JD=L,K
	VQX=VQ(JD)
	IF(VQX.GE.RB)GO TO 20
	IF(VQX.EQ.0)GO TO 11
C  VQX=0 ON NON-STEM NOTES OF CHORDS. (HENCE NO TAILS)
21	B=10.
	IF(L.GT.KN)GO TO 13
	GO TO 16
20	JV=JD
	IF(VQX.GT.RB)GO TO 21
11	JW=JD
	B=20
C  FINDS NEED FOR BEAM TO LEFT 
16	B=B+RA
	DO 5 JE=1,6
5	RN(JE+IS)=RN(JE+M)
	RN(7+IS)=RN(7+M)+RB-RA*2.
C  ADDS RIGHT NUM. OF BEAMS
	IF(L.NE.JV)GO TO 10
	IF(L.EQ.KN)GO TO 377
	IF(L.NE.K)GO TO 10
377	B=-B
C PARTIAL, UNATTACHED BEAM IS PLACED AUTOMATICALLY IN ITMSUB.
	GO TO 8
13	IF(JV.GT.L)GO TO 14
	IF(R(7,L+1).LT.10)GO TO 15
C NEXT FOR DOT ON FOLLOWING NOTE.
	DIS=10.
	GO TO 19
15	DIS=20.
C SHORT INNER BEAM TO LEFT OF STEM
19	B=-RA
	GO TO 16
14	DIS=30
C  LONG INNER BEAM
	JV=-JV
	GO TO 16

C  PARTIAL BEAM IS ON RIGHT(+) OR LEFT(-).  RBM IS LENGTH.
10	IF(L.EQ.KN)GO TO 22
	IF(JV.GE.0)GO TO 17
	B=R(3,L)
	JV=-JV
	L=JV
22	IF(VQ(JW+1).GT.VQ(JW))GO TO 17
	VQ(JW)=VQ(JW+1)
	JW=JW-1
17	IF(L.NE.JB)GO TO 18
	IF(B.LT.20.)L=JV
C PUTS BEAMS IN RIGHT PLACE.
18	RC=R(10,L)
	IF(RC.EQ.0)GO TO 23
	RB=2.44*RSTJ2
	IF(ABS(R(4,L)).GE.100)RB=RB*.6
C  GET WIDTH OF NOTE FOR DISPLACEMENT
CC18	RB9=R(3,L)
	IF(RC.EQ.2)RB=-RB
	RC=RB
CCC	B=B+RC
23	RB9=RC+R(3,L)
C  THIS WILL BE POS.3
	DIS=RA+DIS
C  DISPLACES
	GO TO 8
2	CONTINUE
	RETURN
8	JB=JW+1
C  FINDS SIDE (L,R) FOR PARTIAL BEAM
C  FOR NEW DISPLACEMENT
	RN(IS+11)=-1
	IF(RB9+DIS.EQ.0)GO TO 31
	IF(DIS.LT.10)GO TO 32
	IF(DIS.LT.30)GO TO 33
C INNER PARTIAL BEAM IS NEXT
	DIS=DIS-30
	GO TO 31
32	IF(B.GE.20)GO TO 12
	DIS=B-10
	B=-1
C  -1 PICKS UP POS OF P3
CC	B=RN(3+M)
	GO TO 31
12	DIS=B-20
	B=RB9
	RB9=-1
C  -1 IN P9 WILL PICK UP POS OF P6
CC	RB9=RN(6+M)
C  INNER BEAM ATTACHED TO LFT SIDE.
	GO TO 31
33	B=-DIS
	DIS=0
31	RN(8+IS)=B
	RN(9+IS)=RB9
	RN(10+IS)=DIS
	CALL UPDATE(9)
C  ADDED ANOTHER ITEM (PART. BEAM)
	IF(JB.LE.K)GO TO 6
	END

	SUBROUTINE ACSHFT(RX)
	COMMON /XRN/RN(1) /STF/RSTFAC(0/7),RSTJ2
	1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
	1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA
	1,DBST,NFLG,IXX,ISEMI,IQT,F(50),IAMP,K,KN,M,MODE,IBLA
	1 /RINP/R(10,85),VQ(100)
	EQUIVALENCE (A,F(1)),(B,F(2)),(X,F(4)),
	1(Y,F(5)),(Z,F(6)),(JD,F(7)),(RN1,F(8)),(RH,F(9))
	Z=0
	L=K-1
	M=L-ABS(RX)
	JD=1
	RN1=99
	Y=-.23
	IF(RX.LT.0)GO TO 1
	L=M
	M=K-1
	JD=-1
1	DO 2 N=M,L,JD
C  DOES IT HAVE AN ACCID?
	IF(AMOD(R(5,N),10.).EQ.0)GO TO 2
	A=0
	B=0
	IF(N.LT.L)A=R(6,N+1)
	IF(N.GT.M)B=R(6,N-1)
	IF(RN1.NE.99)GO TO 3
C  IS THIS THE FIRST ACCID?
	RN1=R(4,N)
	GO TO 6
3	RH=R(4,N)
	IF(ABS(RH-RN1).LT.5)GO TO 4
	RN1=RH
	IF(Y.GT.0)Z=Z+.04
C STOPS OCT., ETC. ACCIS BEING MOVED TO LEFT.
	Y=-.23+Z
6	IF(A.EQ.20)GO TO 477
	IF(B.NE.20)GO TO 4
477	Y=Z
4	X=0
	IF(R(6,N).EQ.20)X=-.24
	IF(R(6,N).EQ.10)X=.24
	Y=Y+.23
	IF(X+Y.LT.1)GO TO 7
	RN1=RH
	Z=Z+.04
	Y=0
	IF(A.EQ.20)GO TO 677
	IF(B.NE.20)GO TO 577
677	Y=.23
C  SO Y DOESN'T GET >1.
577	Y=Y+Z
7	X=X+Y
	IF(ABS(X-.04).LT..01)X=0
	IF(X.GE.0)GO TO 5
	Y=.23+Z
	X=Z
5	R(5,N)=R(5,N)+X*RSTFAC(IFIX(STAFF))
C  SPACING OF ACCI. DEPENDS ON STAFF SIZE FACTOR AT THIS POINT
2	CONTINUE
	END

C SETUP ALLOWS SETING UP RHYTHMS ON DESIGNATED STAFF FOR SPACING ALL OTHERS.
	SUBROUTINE SETUP
	INTEGER PWDS
      COMMON /ALF/JX,X,RD,RNL,RN6,M,A,RB,RC,
	1 INP(64) /SCM/V(78),IV,LCNT,STAFF,LIST(200),REND
	1 /PTR/PWDS(1) /LIMIT/LIMIT,ITEM,L,I,IX
	1 /DPY/ST(4000),MEDIT,GO /XRN/RN(1)
	1 /RMOD/RMODE2,SET4,IBEAM,NOSET,STEM,STUP,NTC,
	1 ENDP,RA,RDD,ITB,POSB
	DIMENSION RPOS(2,100)
	EQUIVALENCE (RPOS,ST(3400))

C  RHYTHMIC VALUES ARE SAVED IN P9 OF NOTES AND P7 OF RESTS.
	STUP=-1
C  THIS SENDS INFO TO SUBR. NOTES
	IF(SET4.GT.7)RETURN
C  **** BE SURE SETUP STAFF HAS SPACE VALUES IN NOTES AND RESTS!!!
	IF(ITEM.EQ.0)RETURN
	JX=0
CC	RNL=0
	RA=0
	DO 9534 K=1,ITEM
	L=PWDS(K)
      IF(RN(L+2).NE.SET4)GO TO 9534
	RD=RN(L+1)
	IF(RD.LT.5)GO TO 5
	IF(RD.LT.17)GO TO 9534
5	IF(RD.GT.2)GO TO 6
	RC=7
	IF(RD.EQ.2)RC=5
	IF(RN(L).LT.RC)GO TO 9534
	M=9
	IF(RD.EQ.2)M=7
	RC=RN(L+M)
	IF(RC.EQ.0)GO TO 9534
C  FOR OTHER NOTES ON SPACING STAFF.
	IF(RC.EQ.4./88.)GO TO 9534
C THESE FOR GRACE NOTES   (1/88 NOTES)
CC	IF(RN(L+8).GT.999.)GO TO 9534
C SKIPS MINI-NOTES. BUT TROUBLE IF STEMS CAUSE P8 TO BE ≤ 999.
	GO TO 7
C  SKIPS 'OTHER' CHORD TONES (I.E. P9=0 IN A NOTE)
6	IF(RD.NE.3)GO TO 8
	IF(RN(L).LT.3)GO TO 7
	RC=RN(L+5)
	IF(RC.GE.100)GO TO 7
	IF(RC.GT.3)GO TO 9534
C  SKIPS IF NOT A REAL CLEF  (+100=MINI CLEF)
	GO TO 7
8	IF(RD.NE.4)GO TO 10
	IF(RN(L).GT.2)GO TO 9534
C  SKIPS IF NOT BARLINE (I.E. ONLY 4 PARAMS)
10	IF(RD.NE.2)GO TO 7
	IF(RN(L).LT.5)GO TO 9534
	IF(RN(L+7).EQ.0)GO TO 9534
7	JX=JX+1
	RPOS(1,JX)=RN(L+3)
	IF(RD.GT.2)GO TO 3
C JUMP WHEN TIME VALUES ARE IN P8
CC	RC=RN(L+M)
C  FOR VALUES AUTOMATICALLY SET. ALLOWS NON-DUPLE UNITS IN SETUP
277	RA=RA+RC
C  SUM OF RHYTHS
	GO TO 77
3	RC=-RD
77	RPOS(2,JX)=RC
C  RC IS RHYTHMIC VALUE OF NOTE.
9534	CONTINUE
C  NEXT PUTS ITEMS IN PROPER ORDER IF THEY WEREN'T ALREADY
C*** 2ND NOTE OF DBL STOP CAN'T!! HAVE RHYTH. VALUE *******
	IF(RA.EQ.0)RETURN
C  RA=0 MEANS DIDN'T FIND RHYTHMS ON SPACING STAFF. 

	CALL SORT2(RPOS,JX)
	ENDP=200.
	IF(RPOS(2,JX))ENDP=RPOS(1,JX)
	DO 1 L=1,JX
1	IF(RPOS(2,L).GT.0)GO TO 4
4	RD=RPOS(1,L)
	RB=ENDP-RD
C  TOTAL SPACE FROM 1ST NOTE TO END OF LINE
	RC=RPOS(2,L)
	RPOS(2,L)=RD
C REAL AND AVERAGED POSITIONS OF 1ST NOTE ARE THE SAME.
	DO 2 K=L+1,JX
	RE=RPOS(2,K)
	IF(RE)GO TO 2
	RD=RC/RA*RB+RD
	RC=RE
	RPOS(2,K)=RD
2	CONTINUE
C  1,K=REAL POS.    2,K=AVERAGED POS.
C   IN RHYTH:  POS=(P1-AVG2)*(RL2-RL1)/(AVG2-AVG1)+RL1
	JX=JX+1
	RPOS(1,JX)=ENDP
	RPOS(2,JX)=ENDP
	STUP=0
C  THIS FOR NOTES AND RHYTH
	END